home *** CD-ROM | disk | FTP | other *** search
/ Wonky Flux Batch 2019 02 / Wonky_Flux_Batch_2019-02.zip / Wonky Flux Batch 2019-02 / 075 - Clash of Arms.dsk / NEW.ARMY.S < prev    next >
Text File  |  2019-02-17  |  9KB  |  246 lines
  1.           public viewmap
  2.           on nocar goto link.term
  3.           gosub home
  4.           ch$=pc$
  5.           open #1,"h:war.map1":open #2,"h:war.map2"
  6.           gosub scanmap
  7.           nc=kc
  8.           close #1:open #1,"H:COORDS"
  9.           position #1,8,0:input #1 ky,ky
  10.           if ky<24 ma=0:mp=0:bo=24:yy=1:yo=1:else mp=1:bo=47:yy=24:yo=24:ma=1
  11.           close
  12.           open #1,"h:war.map1":open #2,"h:war.map2"
  13.           xx=1:xo=1
  14.           ch$=pc$:kc=0
  15.           te=1
  16.           gosub printmap
  17.           na=0 
  18.           nn=ab
  19.  
  20. placearmy
  21.           x=xx:y=yy:gosub screen:gosub invoff:print mid$(l1$,xx,1);
  22.           gosub readcoords
  23.           if ma<>mp ma=mp:gosub printmap
  24.           x=xx:y=yy:gosub getline1:gosub screen
  25.           gosub invon:print mid$(l1$,xx,1);:gosub invoff
  26.           x=xx:y=yy:gosub armystrength
  27.           x=1:y=bo:gosub screen:print "Armies: ";ar;" ";
  28.           x=18:y=bo:gosub screen:print"Army "na+1"("nn"): < > Change City, (1-9) Place Army, (ESC) abort";
  29.           gosub getkey
  30.           if (ka$=">") or (ka$=".") ka=1:else ka=0
  31.           if (ka$="<") or (ka$=",") kb=1:else kb=0
  32.           if ((ka=1) and (kc<nc)) kc=kc+1:goto placearmy
  33.           if ((kb=1) and (kc>0)) kc=kc-1:goto placearmy
  34.           if ka$=chr$(27) gosub home:link "a:war.start","fromnew"
  35.           if not(val(ka$)) goto placearmy
  36.           ka=val(ka$):if ka=0 goto placearmy
  37.           if ka+ar>9  x=18:y=bo:gosub screen:print "No more than nine armies per stack.  Press a key             ";:gosub getkey:goto placearmy
  38.           if na+ka>nn x=18:y=bo:gosub screen:print "You don't have that many armies.     Press a key             ";:gosub getkey:goto placearmy
  39.           gosub newarmies
  40.           goto placearmy
  41.  
  42. viewmap
  43.           on nocar goto link.term
  44.           ma=0:bo=24
  45.           open #1,"h:war.map1":open #2,"h:war.map2"
  46.           gosub home
  47.           xx=1:yy=1:xo=1:yo=1
  48.           te=0
  49.           gosub printmap
  50.           ch$=pc$
  51.           nn=ab
  52.           x=xx:y=yy:gosub getline1:gosub screen
  53.           gosub invon:print mid$(l1$,xx,1);:gosub invoff
  54.           x=40:y=bo:gosub screen:print "Explore Map.  Press <cr> to exit.";
  55.           gosub mapmove
  56.           gosub home
  57.           link "a:war.start","maincommand"
  58.  
  59. NewArmies
  60.           ar=ar+ka
  61.           b$=chr$(ar+48)
  62.           position #2,80,yy-1,xx-1
  63.           print #2,b$    ;
  64.           x=xx:y=yy:gosub getline1:gosub armystrength
  65.           x=1:y=bo:gosub screen:print "Armies: ";ar;" ";
  66.           ab=ab-ka:na=na+ka:if na<nn return
  67.           x=xx:y=yy:gosub screen:gosub invoff:print mid$(l1$,xx,1);
  68.           gosub home
  69.           link "a:war.start","fromnew"
  70.  
  71. map0
  72.           if ((ka$="8") or (ka$='W')) and (yy<>1) yy=yy-1:gosub erase
  73.           if ((ka$="2") or (ka$='X')) and (yy<23) yy=yy+1:gosub erase
  74.           return
  75.  
  76. map1
  77.           if ((ka$="8") or (ka$='W')) and (yy<>24) yy=yy-1:gosub erase
  78.           if ((ka$="2") or (ka$='X')) and (yy<46) yy=yy+1:gosub erase
  79.           return
  80.  
  81. getkey
  82.           ka=key(0):if ka=0 goto getkey
  83.           ka$=chr$(ka)
  84.           if asc(ka$)>96 ka$=chr$(asc(ka$)-32)
  85.           poke 99,0:poke 100,0
  86.           return
  87.  
  88. map2
  89.           if (ka$="K") and (xx<70) xx=xx+10:gosub erase:goto mapmv2
  90.           if (ka$="J") and (xx>10) xx=xx-10:gosub erase:goto mapmv2
  91.           if (ka$="I") and (yy>29) and (ma=1) yy=yy-5:gosub erase:goto mapmv2
  92.           if (ka$="I") and (yy>6) and (ma=0) yy=yy-5:gosub erase:goto mapmv2
  93.           if (ka$="M") and (yy<18) and (ma=0) yy=yy+5:gosub erase:goto mapmv2
  94.           if (ka$="M") and (yy<41) and (ma=1) yy=yy+5:gosub erase:goto mapmv2
  95.           if (ka$="I") and (ma=1) ka$="8":yy=24:goto map3
  96.           if (ka$="M") and (ma=0) ka$="2":yy=23:goto map3
  97.  
  98. mapmove
  99.           gosub getkey
  100.           if instr(ka$,"IJKM") goto map2
  101. map3
  102.           if instr(ka$,"147QAZ") ml=1:else ml=0
  103.           if instr(ka$,"369CDE") mr=1:else mr=0
  104.           if (ml) and (xx<>1) xx=xx-1:gosub erase
  105.           if (mr) and (xx<79) xx=xx+1:gosub erase
  106.           if instr(ka$,"QE79") ka$="8":else if instr(ka$,"ZC13") ka$="2"
  107.           if ((ka$="8") or (ka$='W')) and (yy=24) and (ma=1) ma=0:bo=24:yy=23:gosub printmap:xo=xx:yo=yy:goto mapmv2
  108.           if ((ka$="2") or (ka$='X')) and (yy=23) and (ma=0) ma=1:bo=47:yy=24:gosub printmap:xo=xx:yo=yy:goto mapmv2
  109.           if ma=0 gosub map0:else gosub map1
  110. mapmv2
  111.           if ka$=chr$(27) return
  112.           if ka$=chr$(13) return
  113.           if instr(ka$," YN5") return
  114.           y=yy:gosub getline1
  115.           x=xx:y=yy:gosub screen:gosub invon:print mid$(l1$,xx,1);chr$(8);:gosub invoff
  116.           if ok ok=0:return
  117.           if instr(mid$(l1$,xx,1),"ABCDEF") x=9:y=bo:gosub screen:gosub armystrength:print ar;" ";:else if ar<>0 x=9:y=bo:gosub screen:print "0";:ar=0
  118.           if mid$(l1$,xx,1)<>tr$ gosub getterrain:x=24:y=bo:gosub screen:print ms$;
  119.           goto mapmove
  120.  
  121. getterrain
  122.           a$=mid$(l1$,xx,1):if instr(a$,"ABCDEF") am=1:else am=0
  123.           y=yy:gosub getline2:b$=mid$(l2$,xx,1)
  124.           if a$="#" ms$="Impassable"
  125.           if a$=" " ms$="Land      "
  126.           if a$=":" ms$="Water     "
  127.           if a$="+" ms$="Empty Boat"
  128.           if a$="=" ms$="Deep Water"
  129.           if a$="*" ms$="City      "
  130.           if (am) and (asc(a$)>96) and (asc(b$)<65) ms$="Army      "
  131.           if (asc(a$)>96) and (am) and (asc(b$)>64) ms$="Army/Boat "
  132.           if (asc(a$)>64) and (asc(a$)<91) ms$="Army/City "
  133.           tr$=a$
  134.           return
  135.  
  136. armystrength
  137.           y=yy:gosub getline2
  138.           a$=mid$(l2$,xx,1)
  139.           if instr(a$,"0123456789") ar=val(a$):return
  140.           if instr(a$,"ABCDEFGHI") ar=asc(a$)-64:return
  141.           ar=0:return 
  142.                          ;
  143.                          ; Scan the map for character CH$ and records coordinates in H:COORDS
  144.                          ;
  145.  
  146. ScanMap
  147.           x=40:y=bo:gosub screen
  148.           print \"Wait..scanning map...                   ";
  149.           kill "H:COORDS":create "H:COORDS"
  150.           kc=0:kb=0:if (asc(ch$)>96) and (asc(ch$)<123) kb=1:kb$=chr$(asc(ch$)-32)
  151.           for y = 2 to 45
  152.           gosub getline1:gosub getline2
  153.           ka=instr(ch$,l1$)
  154.           if not ka goto PastCheck
  155.  
  156.           for x = ka to 79
  157.           ka$=mid$(l1$,x,1)
  158.           if kb and (ka$=kb$) then gosub FoundMatch
  159.           next
  160. PastCheck
  161.           next:return
  162.  
  163. FoundMatch
  164.           close #1:open #1,"H:COORDS"
  165.           position #1,8,kc:print #1 x,y
  166.           position #1,8,kc+1:print #1 0,0
  167.           close #1:open #1,"H:WAR.MAP1"
  168.           kc=kc+1
  169.           return
  170.  
  171.                          ;
  172.                          ; Read coordinates from "H:COORDS" and calls Move routine
  173.                          ; Make sure KC=0 before calling, and don't use KC in move routine
  174.                          ;
  175.  
  176. ReadCoords
  177.           close #1:open #1,"H:COORDS"
  178.           position #1,8,kc:input #1 kx,ky
  179.           close #1:open #1,"H:WAR.MAP1"
  180.           if (kx=0) and (ky=0) kc=kc-1:return
  181.           xx=kx:yy=ky
  182.           if yy<24 mp=0:bo=24:else mp=1:bo=47
  183.           return
  184.  
  185. erase
  186.           y=yo:gosub getline1
  187.           a$=mid$(l1$,xo,1)
  188.           x=xo:y=yo:gosub screen
  189.           print a$       ;
  190.           xo=xx:yo=yy
  191.           return
  192.  
  193. printmap
  194.           gosub home
  195.           if ma=0 fn=1:else fn=24 
  196.           for y=fn to fn+22
  197.           gosub getline1
  198.           print l1$
  199.           next
  200.           x=xx:y=yy:gosub getline1:gosub armystrength
  201.           x=1:y=bo:gosub screen:print "Armies: ";ar;" ";
  202.           if te<>1 x=15:gosub screen:print "Terrain: ";ms$;
  203.           return
  204.  
  205. Screen
  206.           if ma=0 ve=y:else ve=y-23
  207.           print #3 chr$(30);chr$(31+x);chr$(31+ve);
  208.           if (pt) or ((pt=0) and (an=0)) print #4 chr$(30);chr$(31+x);chr$(31+ve);
  209.           if AN print #4 chr$(27); "["; ve; ";"; x; "f";
  210.           return
  211.  
  212. InvOn
  213.           print #3 chr$(15);
  214.           if (pt) or ((pt=0) and (an=0)) print #4 chr$(15);
  215.           if an print #4 chr$(27);"[1m";
  216.           return
  217.  
  218. InvOff
  219.           print #3 chr$(14);
  220.           if (pt) or ((pt=0) and (an=0)) print #4 chr$(14);
  221.           if an print #4 chr$(27);"[0m";
  222.           return
  223.  
  224. Home
  225.           print #3 chr$(12);
  226.           if (pt) or ((pt=0) and (an=0)) print #4 chr$(12);
  227.           if an print #4 chr$(27);"[H";chr$(27);"[J";
  228.           return
  229.  
  230. rndm
  231.           zl$=rnd$
  232.           zl=((random(10000)+100)/100):if zl>100 then zl=zl-1
  233.           return
  234.  
  235. getline1
  236.           position #1,80,y-1
  237.           input #1,l1$
  238.           return
  239. getline2
  240.           position #2,80,y-1
  241.           input #2,l2$
  242.           return
  243.  
  244. link.term
  245.           link "a:war.start","termgame"
  246.